home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / magnif1a / magnifie.frm (.txt) next >
Encoding:
Visual Basic Form  |  1999-09-12  |  5.4 KB  |  135 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "MagNifier2"
  4.    ClientHeight    =   2445
  5.    ClientLeft      =   60
  6.    ClientTop       =   345
  7.    ClientWidth     =   2055
  8.    LinkTopic       =   "Form1"
  9.    ScaleHeight     =   163
  10.    ScaleMode       =   3  'Pixel
  11.    ScaleWidth      =   137
  12.    StartUpPosition =   3  'Windows Default
  13.    Begin VB.Timer Timer1 
  14.       Interval        =   50
  15.       Left            =   1080
  16.       Top             =   720
  17.    End
  18.    Begin VB.VScrollBar VScroll1 
  19.       Height          =   1575
  20.       LargeChange     =   5
  21.       Left            =   1560
  22.       Max             =   100
  23.       Min             =   1
  24.       TabIndex        =   1
  25.       Top             =   0
  26.       Value           =   100
  27.       Width           =   255
  28.    End
  29.    Begin VB.Label Label2 
  30.       Alignment       =   1  'Right Justify
  31.       Caption         =   "1"
  32.       Height          =   255
  33.       Left            =   1560
  34.       TabIndex        =   2
  35.       Top             =   2160
  36.       Width           =   495
  37.    End
  38.    Begin VB.Label Label1 
  39.       Caption         =   "Label1"
  40.       Height          =   255
  41.       Left            =   0
  42.       TabIndex        =   0
  43.       Top             =   2160
  44.       Width           =   1215
  45.    End
  46. Attribute VB_Name = "Form1"
  47. Attribute VB_GlobalNameSpace = False
  48. Attribute VB_Creatable = False
  49. Attribute VB_PredeclaredId = True
  50. Attribute VB_Exposed = False
  51. 'MagNifier2 by oigres P. Email oigres@postmaster.co.uk
  52. 'Based on the C++ tool Zoomin (Lupe?)
  53. 'New features :Resizeable form, new resolution, bug fix 12/sept/99
  54. 'All code written by oigres P.
  55. 'indented by indenter5 from http://www.BMSLtd.co.uk by Stephen Bullen
  56. Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  57. Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  58. Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
  59. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  60. Private Declare Function GetDesktopWindow Lib "user32" () As Long
  61. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  62. Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
  63. Private Const HORZRES = 8
  64. Private Const VERTRES = 10
  65. Private Type POINTAPI
  66.     x As Long
  67.     y As Long
  68. End Type
  69. Private Type RECT
  70.     Left As Long
  71.     Top As Long
  72.     Right As Long
  73.     Bottom As Long
  74. End Type
  75. Const RDW_ERASE = &H4
  76. Const RDW_INVALIDATE = &H1
  77. Const SRCCOPY = &HCC0020
  78. Const WM_PAINT = &HF
  79. Dim frmH As Long, magnify As Integer
  80. Private Sub Form_Load()
  81.     Call VScroll1_Change
  82.     'SetCapture Form1.hwnd
  83. End Sub
  84. Private Sub Form_Resize()
  85.     Form1.Cls 'clear rubbish between labels when resize
  86.     VScroll1.Left = Form1.ScaleWidth - VScroll1.Width
  87.     VScroll1.Height = Form1.ScaleHeight - Label1.Height
  88.     Label1.Top = Form1.ScaleHeight - Label1.Height
  89.     Label2.Left = Form1.ScaleWidth - Label2.Width
  90.     Label2.Top = Form1.ScaleHeight - Label2.Height
  91. End Sub
  92. Private Sub Label1_Click()
  93. MsgBox "MagNifier2 by oigres P" & vbCrLf & _
  94. "Email: oigres@postmaster.co.uk", vbInformation, "MagNifier2"
  95. End Sub
  96. Private Sub Timer1_Timer()
  97.     Dim cp As POINTAPI
  98.     GetCursorPos cp
  99.     Label1.Caption = cp.x & Space(6 - Len(CStr(cp.x))) & ":" & cp.y
  100.     Dim dsDC As Long, lpPT As POINTAPI
  101.     dsDC = GetDC(0&)
  102.     'get screen width, height
  103.     hr = GetDeviceCaps(dsDC, HORZRES)
  104.     vr = GetDeviceCaps(dsDC, VERTRES)
  105.     dshwnd = GetDesktopWindow()
  106.     '      vscroll1=1..100 so 1/100=.1; 100/100=1;New Resolution
  107.     Percent = VScroll1.Value / 100
  108.     lengthx = (Form1.ScaleWidth - VScroll1.Width) * Percent
  109.     lengthy = (Form1.ScaleHeight - Label1.Height) * Percent
  110.     'center image about mouse
  111.     offsetx = lengthx \ 2
  112.     offsety = lengthy \ 2
  113.     blitareax = Form1.ScaleWidth - VScroll1.Width 'actual area to blit to
  114.     blitareay = Form1.ScaleHeight - Label1.Height
  115.     'Debug.Print lengthx; lengthy; Percent; offsetx; offsety
  116.     'stop copying the screen off the edges <0 and  >horzres
  117.     If cp.x - offsetx >= 0 And cp.x + offsetx < hr Then '800=screen width
  118.         If cp.y - offsety >= 0 And cp.y + offsety < vr Then '600= screen height
  119.             '                dest hdc ,destx,desty,width,height, sourceDC, source x,sourcey,sourcewidth,sourceheight,raster operation
  120.             ret = StretchBlt(Form1.hdc, 0, 0, blitareax, blitareay, dsDC, cp.x - offsetx, cp.y - offsety, lengthx, lengthy, SRCCOPY)
  121.         End If
  122.     End If
  123.     'Form1.Line (0, 0)-(Form1.ScaleWidth - VScroll1.Width, Form1.ScaleHeight - Label1.Height)
  124.     'Form1.Line (Form1.ScaleWidth - VScroll1.Width, 0)-(0, Form1.ScaleHeight - Label1.Height)
  125.     ReleaseDC dshwnd, dsDC 'previous bug not releasing memory
  126. End Sub
  127. Private Sub VScroll1_Change()
  128.     'magnify = VScroll1.Value ;100 is max vscroll value
  129.     'output 2 decimal places
  130.     Label2.Caption = Format(100 / VScroll1.Value, "FIXED")
  131. End Sub
  132. Private Sub VScroll1_Scroll()
  133.     Label2.Caption = Format(100 / VScroll1.Value, "FIXED")
  134. End Sub
  135.